home *** CD-ROM | disk | FTP | other *** search
/ Run Magazine ReRun: Productivity Pak 3 / rerun-productivity-pak-iii-side-a.d64 / runfile 64.bas (.txt) < prev    next >
Encoding:
Commodore BASIC  |  1989-01-01  |  18.0 KB  |  622 lines
  1. 10 rem *************************
  2. 20 rem program : runfile 1.0
  3. 30 rem author  : david darus
  4. 40 rem date    : 6/15/87
  5. 50 rem update  : 7/30/87
  6. 60 rem computer: c64
  7. 70 rem *************************
  8. 80 rem command file=1 seq file=2 rel file=3
  9. 90 rem set up variables
  10. 98 dn=8
  11. 100 def fnh(a)=int(a/256):def fnl(a)=a-(rh*256)
  12. 110 print"[147][154]"chr$(8)chr$(14)
  13. 140 x=0:y=0:sw=0:c=0:t=0:t1=0:nc=0:hc=0:cc=0:ec=0:a=0:l=0:en=0:tr=0:sc=0:nf=0
  14. 150 fc=0:nd=0:fl=0:tx=0:ty=0:ox=0:oy=0:nm=0:al=0:ky=0:sp=0:vn=0:tl=0:pl=0:ct=0
  15. 160 ef=0:mr=0:nl=0:rn=0:nr=0:of=0                           
  16. 165 f1=133:f3=134:f5=135:f7=136:f2=137:f4=138:f6=139:f8=140
  17. 170 rl=0:rh=0:rs=0:re=0:rm=0:ip=0:kf=0:kl=0:kp=0:rp=0:r$="":r1$="":ky$=""
  18. 180 cm$="":sp$="":a$="":an$="":er$="":dn$="":ss$="":xp$="":yp$=""
  19. 190 for t=1 to 80:xp$=xp$+"":yp$=yp$+"":sp$=sp$+" ":ul$=ul$+"[164]":next
  20. 200 ss$=chr$(160):pd$=""
  21. 210 c=1:hc=2:cc=15:nc=6:ns=6:ec=8:of=0
  22. 220 nl=22:vn=0:rn=0
  23. 230 sw=40:mr=1000:ct=0:poke 53280,0:poke 53281,0:poke 808,234:goto 280
  24. 240 rem sw=40:mr=2000:ct=1:slow:rem trap 21000
  25. 250 if peek(215)=128 then sw=80:(NULL)%
  26. 270 (NULL)0,1:(NULL)1,1:(NULL)4,1:(NULL)6,1:(NULL)5,15
  27. 272 (NULL)1,chr$(133):(NULL)3,chr$(134):(NULL)5,chr$(135):(NULL)7,chr$(136)
  28. 274 (NULL)2,chr$(137):(NULL)4,chr$(138):(NULL)6,chr$(139):(NULL)8,chr$(140)
  29. 280 dimcr$(16),cx(nc),cy(nc),cm$(nc),tx$(18),fl$(nl),sx(ns),sy(ns),sm$(ns)
  30. 290 mf=30:a=mf+1:dim fx(a),fy(a),fl(a),ft(a),ft$(a),fq(a),fo(a)
  31. 300 dim ix(mr),rd$(mr),si(mr)
  32. 310 fort=1to16:cr$(t)=mid$("[144][159][156][158][129][149][150][151][152][153][154][155]",t,1):next
  33. 320 cm$="[195][207][205][205][193][206][196][211]:[154] [195]lose [197]dit [206]ew [207]pen [213]tils e[216]it"
  34. 330 fort=1 to nc:read cy(t),cx(t),cm$(t):next
  35. 340 data 23,10,"[195]lose",23,16,"[197]dit",23,21,"[206]ew",23,25,"[207]pen",23,30,"[213]tils"
  36. 350 data 23,36,"e[216]it"
  37. 352 sm$="[213][212][201][204][211]:[154] [196]ir [196]os [196]rive#08 [208]rint [211]eq [213]sr"
  38. 353 for t=1 to ns:read sy(t),sx(t),sm$(t):next
  39. 354 data 23,7,"[196]ir",23,11,"[196]os",23,15,"[196]rive#08",23,24,"[208]rint",23,30,"[211]eq"
  40. 355 data 23,34,"[213]sr"
  41. 360 for t=1 to 18:read tx$(t):next
  42. 370 data "[210]un [198]ile 1.0","[196]atabase:","[204]en=","[212]ype:","[193]lpha","[203]ey","[206]um"
  43. 380 data "[211]pecial","[211]earching for field","[198]ile:","[212]otal="
  44. 390 data "[197]stimated # of records","[204]oading database parameters"
  45. 392 data " "
  46. 394 data "[211]elect fields in desired export order   "
  47. 396 data "[211]ort (y/n)","[210]eplace record (y/n)","#recs"
  48. 400 rem set up screen
  49. 410 print"[147]":x=0:y=22:gosub2210
  50. 420 printcr$(ec);:for t=1 to sw:print"[192]";:next:x=0:gosub2210:printtx$(1);
  51. 430 x=0:y=23:gosub2210:printcm$;
  52. 440 rem get commands
  53. 450 c=1:gosub 5110
  54. 460 x=cx(c):y=cy(c):gosub2210:print""cr$(hc);cm$(c);"[146]";
  55. 470 geta$:ifa$=""then470
  56. 480 x=cx(c):y=cy(c):gosub2210:printcr$(cc);cm$(c);
  57. 490 ifa$=chr$(13)then660
  58. 500 ifa$=""then600
  59. 510 ifa$="[157]"then630
  60. 520 ifa$="c"then710
  61. 530 ifa$="e"then810
  62. 540 ifa$="n"then1110
  63. 550 ifa$="o"then1210
  64. 560 ifa$="u"then1610
  65. 570 ifa$="x"then1710
  66. 580 goto460
  67. 590 rem cursor right
  68. 600 c=c+1:ifc>ncthenc=1
  69. 610 goto460
  70. 620 rem cursor left
  71. 630 c=c-1:ifc<1thenc=nc
  72. 640 goto460
  73. 650 rem return
  74. 660 on c goto 710,810,1110,1210,1610,1710:goto470
  75. 700 rem close database
  76. 710 if of=0 then 450
  77. 715 open 1,dn,15,"i":print#1,"s:\\temp.i":close1
  78. 720 of=0:open 2,dn,2,"\\temp.i,u,w":nr=ix(0)
  79. 730 rh=fnh(nr):rl=fnl(nr):print#2,"indx";chr$(vn);chr$(rl);chr$(rh);
  80. 740 if nr=0 then 760
  81. 750 for t=1 to nr:rh=fnh(ix(t)):rl=fnl(ix(t)):print#2,chr$(rl);chr$(rh);:next
  82. 760 close2
  83. 770 open1,dn,15,"s:"+dn$+"bi":print#1,"r:"+dn$+"bi="+dn$+".i"
  84. 780 print#1,"r:"+dn$+".i=\\temp.i":close1
  85. 785 for t=1 to nl:fl$(t)="":next
  86. 790 goto 410
  87. 800 rem edit database
  88. 810 if of=0 then 1030
  89. 820 pd$=ul$:fc=1:nd=0:pl=tl
  90. 830 open1,dn,15:open3,dn,3,dn$+".d"
  91. 840 al=0:ky=0:nm=0:sp=0:gosub 5110:x=0:y=24:gosub2210:print tx$(4);
  92. 850 if ft(fc) and 1 then x=6:y=24:gosub 2210:print""+tx$(5)+"[146]";:al=1
  93. 860 if ft(fc) and 2 then x=12:y=24:gosub 2210:print""+tx$(6)+"[146]";:ky=1
  94. 870 if ft(fc) and 4 then x=16:y=24:gosub 2210:print""+tx$(7)+"[146]";:nm=1
  95. 880 if ft(fc) and 8 then x=20:y=24:gosub 2210:print""+tx$(8)+"[146]";:sp=1
  96. 885 x=sw-11:y=24:gosub 2210:print tx$(18);nr;
  97. 890 x=fx(fc):y=fy(fc):l=fl(fc):an$=ft$(fc)
  98. 900 print cr$(ec);
  99. 910 gosub 3430:t=fl(fc)-len(an$):ft$(fc)=an$+left$(pd$,t)
  100. 920 if a$=chr$(13) and fc=nf then 840
  101. 930 if a$="" or a$=chr$(13) then fc=fc+1:if fc>nf then fc=1
  102. 940 if a$="[145]" then fc=fc-1:if fc<1 then fc=nf
  103. 950 if ct=1 and asc(a$+chr$(0))=27 then a$=""
  104. 960 if a$="" then 1020
  105. 970 if a$=chr$(f1) then gosub 5310:fc=1:rem find rec
  106. 975 if a$=chr$(f2) then gosub 2110:fc=1:rem write rec
  107. 980 if a$=chr$(f3) then kf=1:gosub 1855:fc=1:rem first rec
  108. 985 if a$=chr$(f4) then kf=ix(0):gosub 1855:fc=1:rem last rec
  109. 990 if a$=chr$(f5) then gosub 1950:fc=1:rem read next
  110. 995 if a$=chr$(f6) then gosub 1850:fc=1:rem read prev
  111. 1000 if a$=chr$(f7) then gosub 4010:fc=1:rem clear form fields
  112. 1005 if a$=chr$(f8) then gosub 4060:fc=1:rem print form fields
  113. 1010 goto 840
  114. 1020 close3:close1
  115. 1030 gosub1696:goto430
  116. 1100 rem new database
  117. 1110 if of=1 then 450
  118. 1120 x=0:y=24:gosub2210:print tx$(2);:l=14:x=9:gosub 2320
  119. 1130 if a$="" then dn$="":goto 410
  120. 1140 if an$="" then 1120
  121. 1150 open 2,dn,2,an$+".f,u,r":gosub 5140:close2
  122. 1160 if en=0 then 1110
  123. 1170 if en<>62 then gosub 5060:goto 410
  124. 1180 nf=22:for t=1 to nf:fx(t)=0:fy(t)=t-1:fl(t)=sw-1:ft$(t)=left$(sp$,sw-2)+ss$
  125. 1190 x=fx(t):y=fy(t):gosub2210:print ft$(t);
  126. 1195 ft(t)=0:next:dn$=an$:gosub 2790:dn$="":goto 410
  127. 1200 rem open database
  128. 1210 if of=1 then 1500
  129. 1220 gosub 5110
  130. 1225 x=0:y=24:gosub2210:print tx$(2);:l=14:x=9:gosub 2320:if a$="" then 1500
  131. 1230 if an$="" then 1220
  132. 1240 open 2,dn,2,an$+".f,u,r":gosub 5140:close2:if en<>0 then 1220
  133. 1250 x=0:y=24:gosub2210:print tx$(13);
  134. 1260 tl=0:gosub 3310:if ef=-1 then 1220
  135. 1270 dn$=an$:open 2,dn,2,dn$+".i,u,r":gosub 5140:close2
  136. 1280 if en=0 then 1380
  137. 1290 if en<>62 then gosub 5060:goto 410
  138. 1300 rem create database
  139. 1310 gosub5110:x=0:y=24:gosub2210:print tx$(12);:l=4:x=23:gosub2320
  140. 1320 rn=val(an$):if rn=0 then 1310
  141. 1330 if rn>mr then rn=mr
  142. 1340 open 2,dn,2,dn$+".i,u,w":print#2,"indx";chr$(vn);chr$(0);chr$(0);:close2
  143. 1350 open1,dn,15:open3,dn,3,dn$+".d,l,"+chr$(tl):rh=fnh(rn):rl=fnl(rn)
  144. 1360 rp=1:gosub5010:print#3,chr$(255);:gosub 5010:close3:close1:gosub 5140
  145. 1370 rem read in database index,parms
  146. 1380 of=1:x=sw-22:y=22:gosub2210:printtx$(10);dn$;:t1=1
  147. 1390 for t=1 to nl:x=0:y=t-1:gosub 2210
  148. 1400 if ct=0 then print ft$(t);
  149. 1410 if ct=1 then print left$(ft$(t),sw-1);
  150. 1420 next:for t=1 to nf:t1=t1+fl(t):if(ft(t)and2)<>0 then kl=fl(t):kp=t1-kl:k1=t
  151. 1430 ft$(t)=left$(ul$,fl(t)):next:tl=t1-1
  152. 1440 open 2,dn,2,dn$+".i,u,r"
  153. 1450 get#2,a$,a$,a$,a$:get#2,a$:vn=asc(a$+chr$(0))
  154. 1460 get#2,a$,b$:nr=asc(a$+chr$(0))+(asc(b$+chr$(0))*256):ix(0)=nr
  155. 1470 if nr=0 then 1490
  156. 1480 for t=1 to nr:get#2,a$,b$:ix(t)=asc(a$+chr$(0))+(asc(b$+chr$(0))*256):next
  157. 1490 close2
  158. 1500 goto450
  159. 1600 rem utils database
  160. 1610 gosub 4210:goto 430
  161. 1612 rem select fields
  162. 1615 if of=0 then return
  163. 1620 pd$=sp$:fc=1:so=1:for t=1 to nf:fq(t)=0:fo(t)=0:next
  164. 1622 if fr=2 then x=0:y=23:gosub 2210:print"[211]elect field to search on               ";:goto 1630
  165. 1625 x=0:y=23:gosub 2210:print tx$(15);
  166. 1630 an$=ft$(fc):l=fl(fc):x=fx(fc):y=fy(fc)
  167. 1632 if fr=0 or fr=2 then 1638
  168. 1633 get a$:if a$="" then 1633
  169. 1634 if ct=1 and asc(a$+chr$(0))=27 then a$=""
  170. 1635 if a$="" then return
  171. 1636 goto 1633
  172. 1638 printcr$(ec);:gosub5200:printcr$(cc);
  173. 1640 if a$=chr$(13) and fq(fc)=0 then fq(fc)=so:fo(so)=fc:so=so+1:if fr=2 then fr=1
  174. 1645 if a$="" or a$=chr$(13) then fc=fc+1:if fc>nf then fc=1
  175. 1650 if a$="[145]" then fc=fc-1:if fc<1 then fc=nf
  176. 1655 if ct=1 and asc(a$+chr$(0))=27 then a$=""
  177. 1657 if a$="" then return
  178. 1659 goto 1630
  179. 1660 rem make usr file
  180. 1662 gosub5110:x=0:y=24:gosub 2210:print tx$(16);:l=1:y=24:x=11:gosub 2320
  181. 1665 if an$="n" or an$="[206]" or an$="y" or an$="[217]" then 1675
  182. 1667 goto 1660
  183. 1670 rem build output records
  184. 1675 gosub 6010
  185. 1680 rem sort records
  186. 1685 if an$="y" or an$="[217]" then gosub 7010
  187. 1690 rem output export file
  188. 1691 if c=4 then gosub 8310
  189. 1692 if c=5 then gosub 8210
  190. 1695 if c=6 then gosub 8010
  191. 1696 for t=1 to nf
  192. 1697 ft$(t)=left$(ul$,fl(t)):x=fx(t):y=fy(t):gosub2210:print cr$(cc);ft$(t);
  193. 1698 next
  194. 1699 an$="":return
  195. 1700 rem exit program
  196. 1710 if of=1 then 450
  197. 1720 if ct=0 then poke 808,237:goto1730
  198. 1721 (NULL) 1,"graphic":(NULL) 2,"dload"+chr$(34):(NULL) 3,"directory"+chr$(13)
  199. 1722 (NULL) 4,"scnclr"+chr$(13):(NULL) 5,"dsave"+chr$(34):(NULL) 6,"run"+chr$(13)
  200. 1723 (NULL) 7,"list"+chr$(13):(NULL) 8,"monitor"+chr$(13)
  201. 1730 print"[147][154]"
  202. 1740 end
  203. 1750 rem read record
  204. 1760 t8=fl(fc)-len(an$):ft$(k1)=an$+left$(ul$,t8):ky$=an$:gosub 2550
  205. 1770 if kf<1 then 1830
  206. 1780 rp=1:gosub 5010:r$="":r1$=""
  207. 1790 for t=1 to tl:get#3,a$:r$=r$+a$:next:gosub 5010
  208. 1800 a=1:for t=1 to nf
  209. 1810 ft$(t)=mid$(r$,a,fl(t)):a=a+fl(t)
  210. 1815 x=fx(t):y=fy(t):gosub2210:print cr$(ec);ft$(t);
  211. 1820 next
  212. 1830 return
  213. 1840 rem read prev record
  214. 1850 kf=kf-1:if kf<1 then kf=ix(0)
  215. 1855 rn=ix(kf):if rn=0 then kf=0
  216. 1860 goto 1770
  217. 1940 rem read next record
  218. 1950 kf=kf+1:rn=ix(kf):if rn=0 then kf=1:rn=ix(kf):if rn=0 then kf=0
  219. 1960 goto 1770
  220. 2100 rem write record
  221. 2110 if nr=mr then 2170
  222. 2120 ky$=ft$(k1):gosub 2550
  223. 2130 if kf<1 then gosub 2710:nr=ix(0)
  224. 2140 rp=1:gosub5010
  225. 2150 r$="":r1$="":for t=1 to nf:r$=r$+ft$(t)
  226. 2155 ft$(t)=left$(ul$,fl(t)):x=fx(t):y=fy(t):gosub2210:print ft$(t);
  227. 2157 next:gosub 5110
  228. 2158 an$="y":if kf>0 then x=0:y=24:gosub 2210:print tx$(17);:x=22:l=1:gosub2320
  229. 2160 if an$="y" or an$="[217]" then print#3,r$;
  230. 2170 gosub 5010:return
  231. 2200 rem cursor plot
  232. 2210 if ct=0 then print"";left$(xp$,x);left$(yp$,y);:return
  233. 2220 if ct=1 then print"";left$(xp$,x);left$(yp$,y);:return
  234. 2250 rem cursor read
  235. 2260 if ct=0 then x=peek(211):y=peek(214)
  236. 2270 if ct=1 then poke 5,1:sys 65520:y=peek(7):x=peek(8)
  237. 2280 if x>=sw then x=x-sw
  238. 2290 return
  239. 2300 rem requestor editor
  240. 2310 rem pass x,y,l=length  returns an$
  241. 2320 an$="":gosub2210:print""left$(sp$,l)"[146]";:gosub2210
  242. 2330 get a$:if a$="" then 2330
  243. 2340 a=asc(a$)
  244. 2350 if ct=1 and a=27 then a$=""
  245. 2360 if a$="" then return
  246. 2370 ifa<>13then2390
  247. 2380 gosub2200:printan$;left$(sp$,(l+1)-len(an$));:return
  248. 2390 ifa=20andlen(an$)>0thengosub2450
  249. 2400 ifa=147andlen(an$)>0thengosub2450:goto2320
  250. 2410 ifa<31ora>218then2330
  251. 2420 ifa>90anda<193then2330
  252. 2430 iflen(an$)>=lthen2330
  253. 2440 printa$;:an$=an$+a$:goto2330
  254. 2450 a$=" [146][157]":iflen(an$)>=lthena$=" [157]"
  255. 2460 if ct=0 then printa$;"[157] [146][157]";
  256. 2470 if ct=1 then print"[157] [146][157]";
  257. 2480 an$=left$(an$,len(an$)-1):return
  258. 2490 rem binary search
  259. 2500 rem pass ky$=key string:kl=key len
  260. 2510 rem os=offset into record for key
  261. 2520 rem return kf=key found 0=no 1=yes
  262. 2530 rem -1=search error
  263. 2540 rem rn=record#  ip=insert position
  264. 2550 rem
  265. 2560 rs=1:re=ix(0):kf=0:ip=0:if re<rs then ip=1:return
  266. 2570 rm=int(re/2):if rm=0 then rm=1
  267. 2580 rn=ix(rm):rp=kp:gosub 5010
  268. 2590 r$="":for t=1 to kl:get#3,a$:r$=r$+a$:next
  269. 2600 if ky$=left$(r$,len(ky$)) then kf=rm:return
  270. 2610 if re<=rs then ip=re:kf=0:rn=ix(ip+1):gosub 2640:return
  271. 2620 if ky$>r$ then rs=rm+1:rm=int((re-rs)/2)+rs:goto 2580
  272. 2630 if ky$<r$ then re=rm-1:rm=int((re-rs)/2)+rs:goto 2580
  273. 2640 if rn=0 or rn>mr then r1$="":return
  274. 2650 rp=kp:gosub5010
  275. 2660 r1$="":for t=1 to kl:get#3,a$:r1$=r1$+a$:next:return
  276. 2670 kf=-1:return:rem search error
  277. 2680 rem insert key into index
  278. 2690 rem ip=insert position r$=record string r1$=next record string
  279. 2700 rem ky$=key string  rn=record#
  280. 2710 ix(0)=ix(0)+1:if ix(0)=1 then ip=1:goto 2760
  281. 2720 if ky$<r$ then 2750
  282. 2730 if ky$<r1$ then ip=ip+1:goto 2750
  283. 2740 ip=ix(0):goto 2760
  284. 2750 for t=ix(0) to int(ip+1)step-1:ix(t)=ix(t-1):next
  285. 2760 ix(ip)=ix(0):rn=ix(0)
  286. 2770 return
  287. 2780 rem form maker
  288. 2790 pd$=sp$:fc=1:nd=1:tl=0:tf=0:gosub 5110
  289. 2800 x=fx(fc):y=fy(fc):l=fl(fc):an$=ft$(fc)
  290. 2810 gosub 3430:t=fl(fc)-len(an$):ft$(fc)=an$+left$(pd$,t)
  291. 2820 if a$="" or a$=chr$(13) then fc=fc+1:if fc>nf then fc=1
  292. 2830 if a$="[145]" then fc=fc-1:if fc<1 then fc=nf
  293. 2840 if ct=1 and asc(a$+chr$(0))=27 then a$=""
  294. 2850 if a$="" then 2880
  295. 2860 goto 2800
  296. 2870 rem review form & set field vars
  297. 2880 gosub 5110:x=0:y=24:gosub2210:print tx$(9);
  298. 2890 nd=1:fc=0:al=0:nm=0:sp=0:ky=0:for ty=1 to nf
  299. 2900 x=0:y=ty-1:gosub2210:printft$(ty);
  300. 2910 ef=0:if right$(ft$(ty),1)=ss$ then ef=-1
  301. 2920 ft$(ty)=ft$(ty)+" ":if ef=-1 then ef=0:goto 3190
  302. 2930 for tx=1 to l+1
  303. 2940 a$=mid$(ft$(ty),tx,1)
  304. 2950 if a$<>"[164]" then 3000
  305. 2960 if nd=2 then 2980
  306. 2965 if fc=mf then 3180
  307. 2970 fc=fc+1:nd=2:fl(fc)=0:fx(fc)=tx-1:fy(fc)=ty-1:x=tx-1:y=ty-1:gosub2210
  308. 2980 fl(fc)=fl(fc)+1:print"[164][146]";
  309. 2990 goto 3180
  310. 3000 if nd=1 then 3180
  311. 3010 nd=1:x=0:y=24:gosub2210
  312. 3020 print tx$(4)+" "+tx$(5)+" "+tx$(6)+" "+tx$(7)+" "+tx$(8);
  313. 3030 get a$:if a$="" then 3030
  314. 3040 if ct=1 and asc(a$)=27 then a$=""
  315. 3050 if a$="" then ft(fc)=al+((ky and 1)*2)+(nm*4)+(sp*8):al=0:nm=0:sp=0:goto 3160
  316. 3060 if a$="a" and al=0 then al=1:x=6:gosub2210:print""+tx$(5)+"[146]";:goto 3080
  317. 3070 if a$="a" and al=1 then al=0:x=6:gosub2210:printtx$(5);
  318. 3080 if a$="k" and ky=0 then ky=1:x=12:gosub2210:print""+tx$(6)+"[146]";:goto 3120
  319. 3090 if a$="k" and ky=1 then ky=0:x=12:gosub2210:printtx$(6);
  320. 3100 if a$="n" and nm=0 then nm=1:x=16:gosub2210:print""+tx$(7)+"[146]";:goto 3120
  321. 3110 if a$="n" and nm=1 then nm=0:x=16:gosub2210:printtx$(7);
  322. 3120 if a$="s" and sp=0 then sp=1:x=20:gosub2210:print""+tx$(8)+"[146]";:goto 3140
  323. 3130 if a$="s" and sp=1 then sp=0:x=20:gosub2210:printtx$(8);
  324. 3140 rem
  325. 3150 goto 3030
  326. 3160 gosub 5110:x=0:y=24:gosub2210:print tx$(9);
  327. 3170 if ky=1 then ky=2
  328. 3180 next tx
  329. 3190 next ty
  330. 3200 gosub 5110:if ky=0 then ft(1)=ft(1)or2
  331. 3210 rem write form to disk
  332. 3220 open 2,dn,2,dn$+".f,u,w"
  333. 3230 print#2,"form";chr$(vn);chr$(sw);chr$(nf);
  334. 3240 for t=1 to nf:print#2,ft$(t);:next
  335. 3250 print#2,chr$(fc);
  336. 3260 for t=1 to fc:print#2,chr$(fx(t));chr$(fy(t));chr$(fl(t));chr$(ft(t));
  337. 3270 next
  338. 3280 close2
  339. 3290 return
  340. 3300 rem read form from disk
  341. 3310 open 2,dn,2,an$+".f,u,r"
  342. 3320 get#2,a$,a$,a$,a$:get#2,a$:vn=asc(a$+chr$(0))
  343. 3330 get#2,a$:a=asc(a$+chr$(0)):if sw=40 and a=80 then close2:ef=-1:return
  344. 3340 get#2,a$:nl=asc(a$+chr$(0))
  345. 3350 for t=1 to nl:ft$(t)="":for t1=1 to a:get#2,a$:ft$(t)=ft$(t)+a$:next
  346. 3355 fl$(t)=ft$(t):next
  347. 3360 get#2,a$:nf=asc(a$+chr$(0))
  348. 3370 for t=1 to nf:get#2,a$:fx(t)=asc(a$+chr$(0))
  349. 3380 get#2,a$:fy(t)=asc(a$+chr$(0)):get#2,a$:fl(t)=asc(a$+chr$(0)):tl=tl+fl(t)
  350. 3390 get#2,a$:ft(t)=asc(a$+chr$(0)):next
  351. 3400 close2:ef=0:return
  352. 3410 rem form field editor
  353. 3420 rem pass x,y,l=length  returns an$
  354. 3430 gosub2210:print""+left$(an$,l)+"[146]";:gosub2210:an$="":ox=x:oy=y
  355. 3440 get a$:if a$="" then 3440
  356. 3450 a=asc(a$):if a=f1 or a=f2 then3460
  357. 3455 if a>=f3 and a<=f8 then 3480
  358. 3460 if ct=1 and a=27 then a$=""
  359. 3470 if a$<>"" and a$<>"[145]" and a$<>""then 3490
  360. 3480 x=ox:y=oy:an$=ft$(fc):gosub2210:printan$;:tl=pl:return
  361. 3490 if a$="" and nd<>0 and tf<mf then gosub3730:goto3440
  362. 3491 if a$="" and nd<>0 then 3493
  363. 3492 goto 3500
  364. 3493 b$="":for t2=1 to sw-1:a$=mid$(ft$(fc),t2,1):if a$="[164]" then tl=tl-1
  365. 3494 if a$<>"[164]" and b$="[164]" then tf=tf-1
  366. 3495 b$=a$:next:pl=tl:x=0:gosub2210:ft$(fc)=left$(sp$,sw-1):an$=ft$(fc)
  367. 3496 goto 3430
  368. 3500 if a=f1 or a=f2 then 3510
  369. 3505 ifa<>13then3550
  370. 3510 x=ox:y=oy
  371. 3520 pl=tl:gosub2210
  372. 3530 if ct=0 then printan$;left$(pd$,l-len(an$));:return
  373. 3540 if ct=1 then printan$;left$(pd$,l-len(an$));:return
  374. 3550 ifa=20andlen(an$)>0thengosub3670
  375. 3560 if nd<>0 then 3630
  376. 3570 if a=32 then 3650
  377. 3580 if a=34 then 3440
  378. 3590 if al=1 then if (a and 127) > 64 and (a and 127) < 91 then goto 3650
  379. 3600 if nm=1 then if a>39 and a<58 then 3650
  380. 3610 if sp=1 then if(a>31 and a<48)or(a>57 and a<65)or(a>90 and a<96) then 3650
  381. 3620 goto 3440
  382. 3630 ifa<32ora>218then3440
  383. 3640 ifa>95anda<193then3440
  384. 3650 iflen(an$)>=lthen3440
  385. 3660 printa$;:an$=an$+a$:goto3440
  386. 3670 if mid$(an$,len(an$),1) = "[164]" then return
  387. 3680 a$="":rem a$=" [146][157]":iflen(an$)>=lthena$=" [157]"
  388. 3690 if ct=0 then printa$;"[157] [146][157]";
  389. 3700 if ct=1 then print"[157] [146][157]";
  390. 3710 an$=left$(an$,len(an$)-1):return
  391. 3720 rem field definer
  392. 3730 nd=2:fl=0
  393. 3740 gosub2260:tx=x:ty=y
  394. 3750 gosub 5110:x=0:y=24:gosub2210:print tx$(3);fl;tx$(11);tl;
  395. 3760 x=tx:y=ty:gosub 2210
  396. 3770 get a$:if a$="" then 3770
  397. 3780 a=asc(a$)
  398. 3790 if a$<>"" then 3810
  399. 3795 if fl>0 then tf=tf+1
  400. 3800 nd=1:tx=x:ty=y:gosub 5110:x=tx:y=ty:gosub 2210:return
  401. 3810 if a=20 and fl>0 then gosub 3870
  402. 3820 if a$<>" " then 3740
  403. 3830 iflen(an$)>=lthen3770
  404. 3840 if tl>253 then 3770
  405. 3850 if mid$(ft$(fc),x+1,1)="[164]" then tl=tl-1
  406. 3860 a$="[164]":print a$;:an$=an$+a$:fl=fl+1:tl=tl+1:goto3740
  407. 3870 fl=fl-1:tl=tl-1:a$=" [146][157]":iflen(an$)>=lthena$=" [157]"
  408. 3880 if ct=0 then printa$;"[157] [146][157]";
  409. 3890 if ct=1 then print"[157] [146][157]";
  410. 3900 an$=left$(an$,len(an$)-1):return
  411. 4000 rem clear fields
  412. 4010 for t=1 to nf
  413. 4020 ft$(t)=left$(ul$,fl(t)):x=fx(t):y=fy(t):gosub2210:print ft$(t);:next
  414. 4030 return
  415. 4050 rem print fields
  416. 4060 open4,4,7
  417. 4065 h2=1:for h=1 to nl
  418. 4070 for h1=1 to len(fl$(h)):a$=mid$(fl$(h),h1,1)
  419. 4080 if a$<>"[164]" then print#4,a$;:goto 4100
  420. 4082 for h3=1 to fl(h2):a$=mid$(ft$(h2),h3,1)
  421. 4083 if a$="[164]" then a$=" "
  422. 4085 print#4,a$;:next:h2=h2+1
  423. 4090 h1=h1+1:a$=mid$(fl$(h),h1,1):if a$="[164]" then 4090
  424. 4095 h1=h1-1
  425. 4100 next
  426. 4105 print#4,chr$(13);:next
  427. 4110 close4:return
  428. 4200 rem utils sub menu
  429. 4210 x=0:y=23:gosub 2210:printleft$(sp$,sw);
  430. 4215 x=0:y=24:gosub 2210:printleft$(sp$,sw-1);
  431. 4220 x=0:y=23:gosub 2210:print sm$;
  432. 4230 c=1
  433. 4235 x=sx(c):y=sy(c):gosub 2210:print""cr$(hc);sm$(c);"[146]";
  434. 4240 geta$:ifa$=""then4240
  435. 4245 x=sx(c):y=sy(c):gosub2210:printcr$(cc);sm$(c);
  436. 4250 if a$=chr$(13) then4300
  437. 4255 if a$="" then 4270
  438. 4260 if a$="[157]" then 4280
  439. 4261 if ct=1 and a$=chr$(27) then a$=""
  440. 4262 if a$="" then return
  441. 4265 goto 4235
  442. 4270 c=c+1:if c>ns then c=1
  443. 4275 goto 4235
  444. 4280 c=c-1:if c<1 then c=ns
  445. 4285 goto 4235
  446. 4300 on c goto 4410,4510,4610,4710,4810,4810
  447. 4305 goto 4235
  448. 4400 rem dir
  449. 4410 if ct=0 then 4460
  450. 4420 print"[147]":(NULL) u(dn)
  451. 4422 print"[208]ress [210][197][212][213][210][206] to continue"
  452. 4423 geta$:if a$<>chr$(13) then 4423
  453. 4424 print"[147]";
  454. 4430 for t=1 to nl:print fl$(t):next
  455. 4431 x=0:y=22:gosub2210
  456. 4432 printcr$(ec);:for t=1 to sw:print"[192]";:next:x=0:gosub2210:printtx$(1);
  457. 4440 goto 4215
  458. 4450 rem c64 dir
  459. 4460 print"[147]":gosub 10000
  460. 4490 goto 4422
  461. 4500 rem dos
  462. 4510 x=0:y=24:l=30:gosub2320:if a$="" then goto 4210
  463. 4520 open 1,dn,15,an$:close1:gosub 5060
  464. 4530 goto 4215
  465. 4600 rem drive#
  466. 4610 x=0:y=24:l=2:gosub 2320:a=val(an$):if a>7 and a<12 then dn=a
  467. 4615 a$="[196]rive#":b$="":if dn<10 then b$="0"
  468. 4616 b$=b$+mid$(str$(dn),2)
  469. 4620 sm$(c)=a$+b$
  470. 4630 a$=sm$:sm$=left$(a$,23)+b$+mid$(a$,26)
  471. 4650 goto 4215
  472. 4700 rem print
  473. 4710 rt=0:gosub 5110:x=0:y=24:gosub 2210:print"[210]eport or [204]abels ? (r/l)";
  474. 4711 x=26:y=24:l=1:gosub 2320
  475. 4712 if an$="r" then rt=1
  476. 4713 if an$="l" then rt=2
  477. 4715 if rt=0 then 4710
  478. 4719 gosub 1615:if of=0 then 4215
  479. 4720 gosub 1662:goto 4215
  480. 4800 rem seq,usr
  481. 4810 gosub 1615:if of=0 then 4215
  482. 4820 gosub 1662:goto 4215
  483. 5000 rem position to record#
  484. 5010 rh=fnh(rn):rl=fnl(rn)
  485. 5020 print#1,"p"chr$(96+3)chr$(rl)chr$(rh)chr$(rp)
  486. 5030 print#1,"p"chr$(96+3)chr$(rl)chr$(rh)chr$(rp)
  487. 5040 return
  488. 5050 rem general disk error alert
  489. 5060 gosub 5110:x=0:y=24:gosub2210:print en;" ";er$;tr;sc;" [208]ress [210][197][212][213][210][206]";
  490. 5070 get a$:if a$="" then 5070
  491. 5080 if a$<>chr$(13) then 5070
  492. 5090 close1:close2:close3:return
  493. 5100 rem clear status line
  494. 5110 x=0:y=24:gosub2210:print left$(sp$,sw-1);:return
  495. 5120 x=0:y=23:gosub2210:print left$(sp$,sw-1);:return
  496. 5130 rem disk status reader
  497. 5140 open1,dn,15
  498. 5145 input#1,en,er$,tr,sc:close1
  499. 5150 return
  500. 5200 gosub2210:print""+left$(an$,l)+"[146]";
  501. 5210 get a$:if a$="" then 5210
  502. 5220 a=asc(a$)
  503. 5230 if ct=1 and a=27 then a$=""
  504. 5240 if a$<>"" and a$<>"[145]" and a$<>"" and a$<>chr$(13) then 5210
  505. 5250 if a$=chr$(13) then return
  506. 5255 if fq(fc)<>0 then return
  507. 5260 gosub2210:printcr$(cc);left$(an$,l);:return
  508. 5300 rem find record
  509. 5310 fr=2:gosub 5110:gosub 1615:fc=fo(1):fr=0:if fc=0 then return
  510. 5315 gosub5120:gosub 2210:print "[197]nter search string";
  511. 5320 l=fl(fc):x=0:y=24:gosub 2320
  512. 5330 if ft(fc) and 2 then gosub 1760:gosub 5120:return
  513. 5350 t1=1:t2=1:t5=len(an$)
  514. 5360 if t1=fc then 5400
  515. 5370 t2=t2+fl(t1):t1=t1+1:goto 5360
  516. 5400 t4=fl(fc):rn=0
  517. 5405 rn=rn+1:if rn>ix(0) then gosub5120:return
  518. 5410 rp=t2:gosub 5010:zz$=""
  519. 5420 for t3=1 to t4:get#3,a$:zz$=zz$+a$:next
  520. 5430 if left$(zz$,t5)=an$ then 5440
  521. 5432 get a$
  522. 5434 if ct=1 and asc(a$+chr$(0))=27 then a$=""
  523. 5435 if a$="" then gosub 5120:return
  524. 5437 goto 5405
  525. 5440 gosub 1780:gosub 5120
  526. 5445 x=0:y=23:gosub 2210:print "[210][197][212][213][210][206] - next rec [197][211][195] or [211][212][207][208] - exit";
  527. 5450 get a$:if a$="" then 5450
  528. 5460 if asc(a$)=27 then a$=""
  529. 5470 if a$="" then gosub 5120:return
  530. 5475 if a$=chr$(f8) then gosub 4060:goto 5450
  531. 5480 if asc(a$)=13 then 5405
  532. 5490 goto 5450
  533. 6000 rem build output records
  534. 6010 open1,dn,15:open3,dn,3,dn$+".d":t1=1
  535. 6020 if t1>ix(0) then 6990
  536. 6030 rn=ix(t1):rp=1:gosub 5010:r$="":r1$=""
  537. 6040 for t=1 to tl:get#3,a$:r$=r$+a$:next:gosub 5010
  538. 6050 a=1:for t=1 to nf
  539. 6060 ft$(t)=mid$(r$,a,fl(t)):a=a+fl(t)
  540. 6070 next
  541. 6100 r$=""
  542. 6110 for t=1 to so-1
  543. 6120 r$=r$+ft$(fo(t))
  544. 6130 next
  545. 6140 rd$(t1)=r$:si(t1)=t1:t1=t1+1:goto 6020
  546. 6990 t1=t1-1:close3:close1:return
  547. 7000 rem sort output records
  548. 7010 for j=1 to t1-1
  549. 7020 for k=j+1 to t1
  550. 7030 if rd$(si(j)) > rd$(si(k)) then te=si(j):si(j)=si(k):si(k)=te
  551. 7040 next k
  552. 7050 next j
  553. 7990 return
  554. 8000 rem write output records to usr file
  555. 8010 open1,dn,15:open2,dn,2,dn$+".u,u,w":input#1,en,er$,tr,sc
  556. 8012 if en<>63 then 8020
  557. 8014 x=0:y=24:gosub 2210:print"[210]eplace file (y/n)";
  558. 8015 x=19:l=1:gosub 2320
  559. 8016 if an$="y" or an$="[217]" then print#1,"s:"+dn$+".u":close2:close1:goto 8010
  560. 8020 if en<>0 then close2:close1:gosub 5060:return
  561. 8025 rh=fnh(t1):rl=fnl(t1)
  562. 8027 print#2,"qury";
  563. 8031 print#2,chr$(vn);chr$(rl);chr$(rh);
  564. 8040 print#2,chr$(so-1);:for t=1 to so-1:print#2,chr$(fl(fo(t)));:next
  565. 8050 for t=1 to t1:print#2,rd$(si(t));:next
  566. 8100 close2:close1
  567. 8110 return
  568. 8200 rem write output records to seq file
  569. 8210 open1,dn,15:open2,dn,2,dn$+".s,s,w":input#1,en,er$,tr,sc
  570. 8212 if en<>63 then 8220
  571. 8214 x=0:y=24:gosub 2210:print"[210]eplace file (y/n)";
  572. 8215 x=19:l=1:gosub 2320
  573. 8216 if an$="y" or an$="[217]" then print#1,"s:"+dn$+".s":close2:close1:goto 8210
  574. 8220 if en<>0 then close2:close1:gosub 5060:return
  575. 8250 for t=1 to t1:t5=1
  576. 8252 for t4=1 to so-1:t7=fl(fo(t4))
  577. 8254 for t8=0 to t7-1
  578. 8255 a$=mid$(rd$(si(t)),t5+t8,1):if a$="[164]" then a$=" "
  579. 8257 print#2,a$;:next:t5=t5+t7:print#2
  580. 8259 next:print#2:next
  581. 8260 close2:close1
  582. 8270 return
  583. 8300 rem write output records to printer
  584. 8310 if rt=2 then 8410
  585. 8320 open4,4,7
  586. 8350 for t=1 to t1:t5=1:t6=1
  587. 8352 for t4=1 to so-1:t7=fl(fo(t4)):if t6+t7>79 then print#4:t6=1
  588. 8354 for t8=0 to t7-1
  589. 8355 a$=mid$(rd$(si(t)),t5+t8,1):if a$="[164]" then a$=" "
  590. 8357 print#4,a$;:next:t5=t5+t7:t6=t6+t7+1:print#4," ";
  591. 8358 next:print#4:next
  592. 8360 close4
  593. 8370 return
  594. 8400 rem write output records to labels on printer
  595. 8410 open4,4,7
  596. 8450 for t=1 to t1:t6=0:t5=fy(fo(1)):t9=1
  597. 8452 for t4=1 to so-1:t7=fl(fo(t4)):if t5<>fy(fo(t4)) then print#4:t6=t6+1
  598. 8453 t5=fy(fo(t4))
  599. 8454 for t8=0 to t7-1
  600. 8455 a$=mid$(rd$(si(t)),t9+t8,1):if a$="[164]" then a$=" "
  601. 8457 print#4,a$;:next:print#4," ";:t9=t9+t7
  602. 8458 next
  603. 8459 if t6<7 then print#4:t6=t6+1:goto 8459
  604. 8460 next:close4
  605. 8990 return
  606. 10000 open1,dn,0,"$"
  607. 10010 get#1,a$,a$:t=2
  608. 10020 get#1,a$:if st<>0 then 10060
  609. 10030 get#1,a$,a$,b$:a=asc(b$+chr$(0))*256+asc(a$+chr$(0)):printa;:t=t+4
  610. 10040 get#1,a$:printa$;:t=t+1
  611. 10042 getc$:if c$<>" " then 10045
  612. 10043 poke 198,0
  613. 10044 getc$:if c$<>" " then 10044
  614. 10045 if t<32 then 10040
  615. 10050 t=0:print"[146]":goto 10020
  616. 10060 close1
  617. 10160 return
  618. 20000 open1,8,15,"s0:runfile":close1
  619. 20010 save"runfile",8
  620. 20020 end
  621. 21000 rem resume
  622.